home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1994 / MacHack 1994.toast / MacHack™ 1987-1994 / MacHack™ '92 / Talk & Papers ’92 / Mike Engber (LISP) / RSA.lisp < prev   
Lisp/Scheme  |  1992-06-07  |  9KB  |  240 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;RSA
  3. ;;
  4. ;; The algorithms come from two papers
  5. ;;
  6. ;; R.L. Rivest, A. Shamir, and L. Adelman
  7. ;; A Method for Obtaining Digital Signatures and Public Key Crypto-Systems
  8. ;; CACM, (1978), pp.120-126
  9. ;;
  10. ;; R. Solovay and V. Strassen
  11. ;; A Fast Monte-Carlo Test for Primality
  12. ;; SIAM Journal on Computing, (1977), pp.84-85.
  13.  
  14. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  15.  
  16. ;;;This function RSA encrypts the specified string
  17. (defun RSA-encode-string (in-string public-key)
  18.   (with-input-from-string (in in-string)
  19.     (with-output-to-string (out)
  20.       (RSA-encode-stream in out public-key))))
  21.         
  22.  
  23. ;;;This function RSA decrypts the specified string
  24. (defun RSA-decode-string (in-string private-key)
  25.   (with-input-from-string (in in-string)
  26.     (with-output-to-string (out)
  27.       (RSA-decode-stream in out private-key))))
  28.  
  29.  
  30. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  31.  
  32. ;;;This function RSA encrypts the specified file
  33. (defun RSA-encode-file (in-pathname out-pathname public-key)
  34.   (with-open-file (in in-pathname
  35.                       :direction :input)
  36.     (with-open-file (out out-pathname
  37.                          :direction :output
  38.                          :if-exists :rename-and-delete 
  39.                          :if-does-not-exist :create)
  40.       (RSA-encode-stream in out public-key))))
  41.         
  42.  
  43. ;;;This function RSA decrypts the specified file
  44. (defun RSA-decode-file (in-pathname out-pathname private-key)
  45.   (with-open-file (in in-pathname
  46.                       :direction :input)
  47.     (with-open-file (out out-pathname
  48.                          :direction :output
  49.                          :if-exists :rename-and-delete
  50.                          :if-does-not-exist :create)
  51.       (RSA-decode-stream in out private-key))))
  52.      
  53. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  54.  
  55. ;;;This function RSA encrypts the specified input stream
  56. ;;; and puts the encrypted data onto the specified output stream
  57. (defun RSA-encode-stream (in-stream out-stream public-key)
  58.   (let* ((block-size (1- (RSA-block-size public-key)))
  59.          (block (make-string block-size))
  60.          (i 0))
  61.     (loop
  62.       (when (null (listen in-stream)) (return i))
  63.       (incf i)
  64.       (dotimes (i block-size)
  65.         (setf (char block i) (read-char in-stream nil (code-char 0))))
  66.       (princ (RSA-encode-block block public-key) out-stream))))
  67.  
  68.  
  69. ;;;This function RSA decrypts the specified input stream
  70. ;;; and puts the decrypted data onto the specified output stream
  71. (defun RSA-decode-stream (in-stream out-stream private-key)
  72.   (let* ((block-size (RSA-block-size private-key))
  73.          (block (make-string block-size))
  74.          (i 0))
  75.     (loop
  76.       (when (null (listen in-stream)) (return i))
  77.       (incf i)
  78.       (dotimes (i block-size)
  79.         (setf (char block i) (read-char in-stream t)))
  80.       (princ (RSA-decode-block block private-key) out-stream))))
  81.  
  82. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  83.  
  84. ;;;This function RSA encrypts a single block of message
  85. (defun RSA-encode-block (string public-key)
  86.   (let ((block-size (RSA-block-size public-key)))
  87.     (unless (< (length string) block-size)
  88.       (error "string too long ~a >= ~a to be correctly encoded" (length string) block-size))
  89.     (int-to-string (expt-mod (string-to-int string) (second public-key) (first public-key))
  90.                    block-size)))
  91.  
  92. ;;;This function RSA decrypts a single block of message
  93. (defun RSA-decode-block (string private-key)
  94.  (int-to-string (expt-mod (string-to-int string) (second private-key) (first private-key))))
  95.  
  96. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  97.  
  98. ;;;Returns the encryption block size in character for the specified key
  99. (defun RSA-block-size (key)
  100.   (prog1 (ceiling (integer-length (first key)) 8)))
  101.  
  102.  
  103. ;;;Give a pair of primes this function generates an RSA key pair from them.
  104. ;;;It returns 2 values, the public key and private key.
  105. ;;;Each key is a list of 2 numbers - the 2nd number is actually the key.
  106. (defun RSA-gen-keys (prime-1 prime-2)
  107.   (let* ((p prime-1)
  108.          (q prime-2)
  109.          (phi (* (1- p) (1- q)))
  110.          (pri-key (RSA-choose-private-key p q phi))
  111.          (pub-key (multiplicative-inverse pri-key phi))
  112.          (msg-size (* p q)))
  113.     (values (list msg-size pub-key) (list msg-size pri-key))))
  114.  
  115. ;;;Choose a private key for p,q,phi
  116. (defun RSA-choose-private-key (p q phi)
  117.   (do ((d (+ (max p q) 2) (+ d 2)))
  118.       ((eq (gcd d phi) 1) d)))
  119.  
  120.  
  121. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  122. ;;;Solovay & Strassen prime test.
  123.  
  124. ;;generates a prime of the specified number of digits
  125. (defun gen-prime (digits &key (certainty 20))
  126.   (let* ((ten-expt-digits-1 (expt 10 (1- digits)))
  127.          (ten-expt-digits   (* 10 ten-expt-digits-1))
  128.          (n                 (+ ten-expt-digits-1 (random (* 9 ten-expt-digits-1)))))
  129.     (when (evenp n) (incf n))
  130.     (dotimes (i (ceiling (- ten-expt-digits n) 2) (error "no ~a digit primes found." digits))
  131.       (when (prime-p n certainty) (return-from gen-prime n))
  132.       (incf n 2))))
  133.  
  134. ;;;A list of the first 100 primes
  135. (defconstant *first-primes*
  136.   '(1 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97
  137.     101 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197
  138.     199 211 223 227 229 233 239 241 251 257 263 269 271 277 281 283 293 307 311 313
  139.     317 331 337 347 349 353 359 367 373 379 383 389 397 401 409 419 421 431 433 439
  140.     443 449 457 461 463 467 479 487 491 499 503 509 521 523))
  141.  
  142. ;;;Returns whether n is prime with a certainty of 1 - 1/2^test-count.
  143. ;;;It uses an improved version of the original Solovay & Strassen
  144. ;;;prime test. Based on Eric Bach's suggestion of using a sequence 
  145. ;;;of primes rather than random numbers.
  146. ;;; make sure num_tests <= the number of primes in *first_primes*
  147. (defun prime-p (n test-count)
  148.   (unless (<= test-count (length *first-primes*))
  149.     (error "test-count must be less than ~a." (length *first-primes*)))
  150.   (when (oddp n)
  151.     (let ((prime-list *first-primes*)
  152.           (a nil))
  153.       (dotimes (i test-count n)
  154.         (setf a (pop prime-list))
  155.         (cond
  156.          ((>= a n)        (return n))
  157.          ((> (gcd a n) 1) (return nil))
  158.          ((/= (mod (jacobi a n) n) (expt-mod a (/ (1- n) 2) n)) (return nil)))))))
  159.  
  160. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  161. ;;; misc utils
  162.  
  163. ;;Returns base^power mod modulus
  164. ;;significantly more efficient than (mod (expt base power) modulus)
  165. (defun expt-mod (base power modulus)
  166.   (if (zerop power)
  167.     1
  168.     (let ((i (1- (integer-length power)))
  169.           (result 1))
  170.       (loop
  171.         (when (logbitp i power)
  172.           (setf result (mod (* result base) modulus)))
  173.         (when (zerop i) (return result))
  174.         (setf result (mod (* result result) modulus))
  175.         (decf i)))))
  176.  
  177.  
  178. ;;;Returns the value of the jacobi symbol (m/n)
  179. (defun jacobi (m n)
  180.  (cond
  181.   ((= m 1) 1)
  182.   ((or (zerop m) (evenp n)) 0)
  183.   ((evenp m) (* (if (/= (mod n 8) 3 5) 1 -1) (jacobi (/ m 2) n)))
  184.   (t (* (if (= (mod m 4) (mod n 4) 3) -1 1) (jacobi (mod n m) m)))))
  185.  
  186.  
  187. ;;;Returns multiplicative inverse of x1 mod x0 using the extended
  188. ;;;version of Euclid's algorithm. If the numbers are not relatively
  189. ;;;prime nil will be returned. (algorithm deduced from RSA paper)
  190. (defun multiplicative-inverse (n modulus)
  191.   (labels ((multinv (x1 x0 a1 a0 b1 b0 m)
  192.                     (if (= x1 0)
  193.                       (if (= x0 1) (mod b0 m))
  194.                       (multinv (mod x0 x1) x1
  195.                                (- a0 (* (truncate x0 x1) a1)) a1
  196.                                (- b0 (* (truncate x0 x1) b1)) b1
  197.                                (if m m x0)))))
  198.           (multinv n modulus 0 1 1 0 nil)))
  199.  
  200.  
  201. ;;;This function returns the integer equivalent to the string
  202. (defun string-to-int (s)
  203.  (let ((result 0))
  204.   (dotimes (i (length s) result)
  205.    (setf result (dpb (char-int (char s i)) (byte 8 (* (- (length s) i 1) 8)) result)))))
  206.  
  207.  
  208. ;;;This function returns the string equivalent of an integer
  209. (defun int-to-string (n &optional (str-len (ceiling (integer-length n) 8)))
  210.   (let ((result (make-string str-len)))
  211.     (dotimes (i str-len result)
  212.       (setf (char result i) (code-char (ldb (byte 8 (* (- str-len i 1) 8)) n))))))
  213.  
  214. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  215.  
  216. #|
  217.  
  218. (defvar pub)
  219. (defvar pri)
  220.  
  221. ;;50 digit primes -> ~100 digit keys
  222. (multiple-value-setq
  223.   (pub pri)
  224.   (RSA-gen-keys 77003373946484615565077855874935689789585714881953
  225.                 82763142278558437608609060381372367912327955153689))
  226.  
  227. ;;5 digit primes -> ~10 digit keys - faster performance
  228. (multiple-value-setq (pub pri) (RSA-gen-keys 47251 35747))
  229.  
  230. (RSA-decode-string (RSA-encode-string "the rain in spain" pub) pri)
  231.  
  232. (RSA-decode-string (RSA-encode-string "the rain in spain" pri) pub)
  233.  
  234. (RSA-encode-file (choose-file-dialog) (choose-new-file-dialog) pub)
  235. (RSA-decode-file (choose-file-dialog) (choose-new-file-dialog) pri)
  236.  
  237.  
  238.  
  239.  
  240. |#